home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / examples / lexyacc / cl / hamming.cl < prev    next >
Encoding:
Text File  |  1997-08-18  |  1.4 KB  |  38 lines  |  [TEXT/R*ch]
  1. (* From Gofer demos/examples.gs: Hamming's exercise
  2.  
  3. hamming :: [Int]
  4. hamming = 1 : (map (2* ) hamming || map (3* ) hamming || map (5* ) hamming)
  5.                where (x:xs) || (y:ys)  | x==y  =  x : (xs || ys)
  6.                                        | x<y   =  x : (xs || (y:ys))
  7.                                        | y<x   =  y : (ys || (x:xs))
  8. *)
  9.  
  10. letrec 
  11.   merge = \xs.\ys.
  12.           case xs of
  13.             <1>      -> ys;
  14.         <2> x xr -> case ys of
  15.                           <1>      -> xs;
  16.                           <2> y yr -> if x=y then 
  17.                                        pack{2, x, merge xr yr}
  18.                                   else if x<y then 
  19.                                            pack{2, x, merge xr ys}
  20.                                       else
  21.                                            pack{2, y, merge xs yr}
  22.                         end
  23.           end;
  24.   map = \f.letrec h = \xs. case xs of
  25.                            <1>      -> pack{1};
  26.                            <2> x xr -> pack{2, f x, h xr}
  27.                            end
  28.            in h;
  29.   hamming = pack{2, 1, merge (map (\n.2*n) hamming)
  30.                             (merge (map (\n.3*n) hamming)
  31.                                 (map (\n.5*n) hamming))};
  32.   take = \n.\xs.case xs of
  33.                   <1>      -> pack {1} ;
  34.                   <2> x xr -> if n=0 then pack {1}
  35.                               else pack {2, x, take (n-1) xr}
  36.                 end
  37. in hamming
  38.